---
title: "Structural VAR Results -- Filtered Tone and Filtered ICS"
author: "Amber Boydstun, Ben Highton, and Suzanna Linn"
date: "January 26, 2018"
output: 
  html_notebook: 
    theme: cerulean
    number_sections: TRUE
    toc: TRUE
    toc_depth: 2
    toc_float: 
     collapsed: false
     smooth_scroll: TRUE
---

#Preliminaries

This file estimates the structural vector autoregression in XXXX


Load necessary libraries and dataset. The dataset contains only 2 variables: the residuals from the two models estimated for Table 1, RICS and RTONE.

```{r}
library(vars)
library(foreign)
TD <- read.dta("~/Dropbox/Economy and Media/Runs/ReplicationFiles/PRQ_SVAR_Data.dta")
colnames(TD) <- c("RICS", "RTONE")
#Trim missing observations  
TD<-na.trim(TD)
```

#Lag length selection

In the first step we select the number of lags to include in the VAR. The different lag length selection tests typically select 2 lags, but residuals are not white noise so we continue adding lags until the residuals are white noise.


```{r}
selec <- VARselect(TD, lag.max=12)
selec
```


```{r}
#Estimate a VAR with 2 lags
var.mod.00 <- VAR(TD, p=2, type="const")
#summary(var.mod.00)
#Test for serial correlation
serial.test(var.mod.00, lags.pt = 12, lags.bg = 12, type = "BG")

```
Twelve lags is the minimum number of lags necessary to eliminate autocorrelation in the residuals as based on the Bruesch-Godfrey LM test. 
```{r}
var.mod.01 <- VAR(TD, p=12, type="const")
#Test for serial correlation
serial.test(var.mod.01, lags.pt = 12, lags.bg = 12, type = "BG")
```
##Specify the A and B matrices 
These define the coefficients to be restricted and to be estimated. NAs denote coefficients to be estimated. 

```{r}
newamat <- matrix(c(1,0,
                 NA,1),
                 nrow=2,
                 ncol=2)
#The A matrix needs to be transposed.
newamat2 <- t(newamat)

#The B matrix acts on the errors. The contemporaneous errors are thus specified to be uncorrelated while their variances are estimated.
newbmat <- matrix(c(NA,0,
                    0,NA),
                  nrow=2,
                  ncol=2)

```


# SVAR Estimation

```{r}
results1<-SVAR(x = var.mod.01, estmethod = "direct", Amat = newamat2, Bmat = newbmat,
     hessian = TRUE, method="BFGS")
```



##Generate IRF and Cumulative IRF: Shock in Tone on ICS

#### Simple
```{r, warning=FALSE, echo=TRUE}
fitirf_shock_TONE <- irf(results1, impulse = "RTONE", response = "RICS", n.ahead = 10,
              ortho = FALSE, cumulative = FALSE, boot = TRUE, ci = 0.95,
              runs = 1000, seed = 5555)
```

#### Cumulative
```{r, warning=FALSE, echo=TRUE}
cfitirf_shock_TONE <- irf(results1, impulse = "RTONE", response = "RICS", n.ahead = 10,
               ortho = FALSE, cumulative = TRUE, boot = TRUE, ci = 0.95,
               runs = 1000, seed = 5555)
```



##Generate IRF and Cumulative IRF: Shock in ICS on Tone

#### Simple

```{r, warning=FALSE, echo=TRUE}
#Shock in ics on tone
fitirf_shock_ICS <- irf(results1, impulse = "RICS", response = "RTONE", n.ahead = 10,
               ortho = FALSE, cumulative = FALSE, boot = TRUE, ci = 0.95,
               runs = 1000, seed = 5555)
```

#### Cumulative

```{r, warning=FALSE, echo=TRUE}
cfitirf_shock_ICS <- irf(results1, impulse = "RICS", response = "RTONE", n.ahead = 10,
               ortho = FALSE, cumulative = TRUE, boot = TRUE, ci = 0.95,
               runs = 1000, seed = 5555)
```

# Make Pretty Plots


```{r}
#pdf(width=6, height=4,'IRFS_ALL2.pdf')
par(mfrow = c(2,2), oma=c(0,2,0,2),mar=c(2,4,1,0),
    cex = 0.8)#The order is bottom, left, top, right.
# set up the base plot
x <-c(-2,-1,0,1,2)
y <-seq(0:9)
y<- c(0,1,2,3,4,5,6,7,8,9,10,11,12)
plot(fitirf_shock_TONE$irf$RTONE, type="n", ylim = c(-2, 2), main = "Simple Impulse Response Function", cex.main=.7,
  ylab = "Residual ICS Series", xlab = "",axes = FALSE)
abline(h=0)
axis(2, at=x, labels=x,  col.axis="black", las=2, cex.axis=.6)
axis(1, at=y, labels=y,  col.axis="black", las=0, pos=-2, cex.axis=.6)
lines(fitirf_shock_TONE$Upper$RTONE, col = "red",lty=2)
lines(fitirf_shock_TONE$Lower$RTONE, col = "red",lty=2)
lines(fitirf_shock_TONE$irf$RTONE, col = "red")
# set up the base plot
x <-seq(from=-6, t =6, by=2)
y <-seq(0:9)
y<- c(0,1,2,3,4,5,6,7,8,9,10,11,12)
mar=c(4,4,-2,0) 
plot(cfitirf_shock_TONE$irf$RTONE, type="n", ylim = c(-6, 6), main = "Cumulative Impulse Response Function", cex.main =.7,
  ylab = "", 
  xlab = "", axes=FALSE)
abline(h=0)
axis(2, at=x, labels=x,  col.axis="black", las=2, cex.axis=.6)
axis(1, at=y, labels=y,  col.axis="black", las=0, pos=-6, cex.axis=.6)
lines(cfitirf_shock_TONE$Upper$RTONE, col = "red",lty=2)
lines(cfitirf_shock_TONE$Lower$RTONE, col = "red",lty=2)
lines(cfitirf_shock_TONE$irf$RTONE, col = "red")
# set up the base plot
x <-seq(from=-12, to=10, by=4)
y<- c(0,1,2,3,4,5,6,7,8,9,10,11,12)
plot(fitirf_shock_ICS$irf$RICS, type="n", ylim = c(-12, 10), main = NULL, cex.main=.7,
  ylab = "Residual Tone Series", xlab = "Months",axes = FALSE)
abline(h=0)
axis(2, at=x, labels=x,  col.axis="black", las=2, cex.axis=.6)
axis(1, at=y, labels=y,  col.axis="black", las=0, pos=-12, cex.axis=.6)
lines(fitirf_shock_ICS$Upper$RICS, col = "red",lty=2)
lines(fitirf_shock_ICS$Lower$RICS, col = "red",lty=2)
lines(fitirf_shock_ICS$irf$RICS, col = "red")
# set up the base plot
x <- seq(from=-35, to=5, by=5)
y<- c(0,1,2,3,4,5,6,7,8,9,10,11,12)
mar=c(4,4,-2,0) 
plot(cfitirf_shock_ICS$irf$RICS, type="n", ylim = c(-35, 5), main = NULL, cex.main =.7,
  ylab = "", 
  xlab = "Months", axes=FALSE)
abline(h=0)
axis(2, at=x, labels=x,  col.axis="black", las=2, cex.axis=.6)
axis(1, at=y, labels=y,  col.axis="black", las=0, pos=-35, cex.axis=.6)
lines(cfitirf_shock_ICS$Upper$RICS, col = "red",lty=2)#
lines(cfitirf_shock_ICS$Lower$RICS, col = "red",lty=2)
lines(cfitirf_shock_ICS$irf$RICS, col = "red")
#dev.off()
```